home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 7 / DOS226.dsk / SEARCH.bas < prev    next >
BASIC Source File  |  2012-02-16  |  37KB  |  652 lines
  1. 0  REM FAMILY ROOTS: SEARCH PROGRAM. COPYRIGHT 1982, STEPHEN C. VORENBERG
  2. 20  GOTO 12000
  3. 100  GOSUB 2600
  4. 110 BB = W: FOR I = 0 TO Q(37) -1: IF PA(I) <W  AND W < = CT(I)  THEN W = W -PA(I) +Q(36) *I:I = Q(37)
  5. 120  NEXT :J =  LEN(NA$(W)):K = 0:N1$ = "":N2$ = "":N3$ = "":N4$ = "": IF J = 0  THEN 330
  6. 130  FOR I =  LEN(NA$(W)) TO 1  STEP  -1: IF  MID$ (NA$(W),I,1) < >Q$(5)  THEN 310
  7. 140 K = K +1: IF I -J = 0  THEN 300
  8. 150  ON K GOTO 220,210,200
  9. 200 N1$ =  MID$ (NA$(W),I +1,J -I): GOTO 300
  10. 210 N2$ =  MID$ (NA$(W),I +1,J -I): GOTO 300
  11. 220 N4$ =  RIGHT$(NA$(W),J -I)
  12. 300 J = I -1: IF K = 3  THEN I = 1
  13. 310  NEXT : IF J -I >0  THEN N3$ =  LEFT$(NA$(W),J -I)
  14. 320  IF K = 2  THEN N1$ = N2$:N2$ = N3$:N3$ = ""
  15. 330 W = BB: RETURN 
  16. 350 J = 0: IF   NOT OP(3)  THEN  GOSUB 395: GOSUB 415: GOSUB 435: GOSUB 460: GOTO 380
  17. 355  IF OP(4)  AND N3$ < >""  THEN 370
  18. 360 J = 1: GOSUB 415:J = 0: IF IX +2 < = FC  THEN  PRINT ", ";:IX = IX +2
  19. 365  GOSUB 395: GOSUB 460: GOTO 380
  20. 370 J = 1: GOSUB 435:J = 0: IF IX +2 < = FC  THEN  PRINT ", ";:IX = IX +2
  21. 375  GOSUB 395: GOSUB 415: GOSUB 460
  22. 380  IF OP(8)  THEN  IF IX + LEN( STR$(W)) +6 >FC  THEN  GOSUB 480
  23. 385  IF OP(8)  THEN  PRINT " (ID="W")";:IX = IX + LEN( STR$(W)) +6
  24. 390  RETURN 
  25. 395  IF N1$ = ""  THEN  RETURN 
  26. 400  IF IX + LEN(N1$) < = FC  THEN 413
  27. 401  IF FC < = IX  THEN 413
  28. 403 LA = 0: FOR K = FC -IX TO 1  STEP  -1: IF  MID$ (N1$,K,1) = " "  OR  MID$ (N1$,K,1) = ";"  OR  MID$ (N1$,K,1) = "."  OR  MID$ (N1$,K,1) = "-"  THEN  PRINT  LEFT$(N1$,K);:A$ =  RIGHT$(N1$, LEN(N1$) -K): GOSUB 480:K = 1:LA = 1
  29. 406  NEXT : IF LA >0  THEN  GOSUB 480: GOTO 413
  30. 409  IF  LEN(N1$) +IX >FC  THEN 401
  31. 413  PRINT N1$;:IX = IX + LEN(N1$): RETURN 
  32. 415  IF N2$ = ""  THEN  RETURN 
  33. 418  IF IX + LEN(N2$) +1 >FC  THEN  GOSUB 480: GOTO 425
  34. 420  IF   NOT J  THEN  PRINT " ";:IX = IX +1
  35. 425  PRINT N2$;:IX = IX + LEN(N2$)
  36. 430  RETURN 
  37. 435  IF   NOT OP(4)  OR N3$ = ""  THEN  RETURN 
  38. 440  IF IX + LEN(N3$) +1 >FC  THEN  GOSUB 480: GOTO 450
  39. 445  IF   NOT J  THEN  PRINT " ";:IX = IX +1
  40. 450  PRINT N3$;:IX = IX + LEN(N3$)
  41. 455  RETURN 
  42. 460  IF N4$ = ""  THEN  RETURN 
  43. 465  IF IX + LEN(N4$) +1 >FC  THEN  GOSUB 480: GOTO 475
  44. 470  PRINT " ";:IX = IX +1
  45. 475  PRINT N4$;:IX = IX + LEN(N4$): RETURN 
  46. 480  PRINT :LC = LC +1: PRINT  SPC( 9);:IX = IX +3: RETURN 
  47. 580  IF   NOT Q(1)  THEN  RETURN 
  48. 581  IF Q(41) >2  THEN  PRINT  CHR$(27) CHR$(17)
  49. 582 FC = Q(23) *Q(Q(6)) -1: PRINT  CHR$(4)"PR#"Q(3): PRINT Q$(1)Q$(Q(7));: RETURN 
  50. 600  IF   NOT Q(1)  THEN  RETURN 
  51. 601 FC = Q(22): IF Q$(2) < >""  THEN  PRINT Q$(2)
  52. 605  PRINT  CHR$(4)"PR#"Q(43): RETURN 
  53. 690  GET YN$: POKE  -16368,0: NORMAL : PRINT YN$: IF  ASC(YN$) >95  THEN YN$ =  CHR$( ASC(YN$) -32)
  54. 695  RETURN 
  55. 700  PRINT : PRINT "SEARCH RECORDS BY:": PRINT 
  56. 705 L = H1 -1: IF LO >0  THEN L = H1
  57. 710  FOR X = 1 TO L: PRINT X") "H1$(X): NEXT 
  58. 720  PRINT : INVERSE : PRINT "CHOICE (1-"L",P)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  59. 730  IF YN$ = "P"  THEN  GOSUB 9000: GOTO 700
  60. 740 C3 =  VAL(YN$): IF C3 <1  OR C3 >L  THEN 720
  61. 745  IF C3 < >H1  AND LO >0  THEN LO = 0: PRINT "LIST IN MEMORY CLEARED": FOR I = 0 TO Q(18): FOR J = 0 TO 1:S$(I,J +5) = S$(I,J +FL -1): NEXT : NEXT :FL = 6
  62. 750  PRINT :OP(8) = 1: ON C3 GOSUB 6200,6000,6800,6060:OP(8) = 0
  63. 760  POKE 34,0: GOSUB 2300: RETURN 
  64. 850  PRINT : IF Q(43) = 0  OR Q(40)  THEN  HOME : RETURN 
  65. 855  PRINT  CHR$(12): RETURN 
  66. 860  PRINT "": RETURN 
  67. 990  IF  PEEK( -16384) =  ASC(CZ$) +128  THEN XZ = Q(28):XY = XZ: POKE  -16368,0
  68. 995  RETURN 
  69. 1000 M = 0:TT$ = "WHICH ":K = 0:L =  VAL(S$(0,0)): IF Q(26)  THEN K = 1
  70. 1005  GOSUB 850:L =  VAL(S$(0,0)): PRINT S$(C1,2)" BY:"
  71. 1010  PRINT : FOR I = 1 TO L: PRINT I") "S$(I,0): NEXT : IF Q(44) <1  THEN 1020
  72. 1015  FOR I = 1 TO Q(44): PRINT I +L") "Q$(I +11): IF I +L = 17  THEN  PRINT "TYPE ANY KEY TO CONTINUE";: GOSUB 690
  73. 1018  NEXT : IF Q(26)  THEN  PRINT L +Q(44) +1") AUTO DATE"
  74. 1020  PRINT : PRINT "SELECT UP TO "Q(42)" OF THESE BY NUMBER": PRINT 
  75. 1030  INVERSE : PRINT TT$"NUMBER:";: NORMAL : INPUT " ";V1$
  76. 1040  IF V1$ = ""  THEN 1100
  77. 1042 OG =  VAL(V1$): IF OG <1  OR OG >L +Q(44) +K  THEN 1005
  78. 1045 TT$ = "NEXT "
  79. 1050 M = M +1:OE(M) = OG: IF M <Q(42)  THEN 1030
  80. 1100  IF M = 0  THEN  RETURN 
  81. 1110  PRINT : PRINT "YOU HAVE SELECTED:": PRINT : FOR I = 1 TO M: PRINT OE(I)") ";: IF OE(I) < = L  THEN  PRINT S$(OE(I),0): GOTO 1120
  82. 1115  IF OE(I) < = L +Q(44)  THEN  PRINT Q$(OE(I) -L +11): GOTO 1120
  83. 1118  PRINT "AUTO DATE"
  84. 1120  NEXT : PRINT : INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 1000
  85. 1130  IF C1 = 5  THEN EM$(1) = "":T = 1: GOTO 1260
  86. 1150  PRINT : PRINT "PICK UP TO "Q(42)" DIFFERENT EMBEDDED CHAR" CHR$((Q(43) = 0) *45) CHR$((Q(43) = 0) *13)"ACTER STRINGS TO SEARCH FOR IN THE": PRINT "ABOVE:"
  87. 1155 T = 0: IF Q(9) >0  THEN  CALL G(0)
  88. 1165 TT$ = "FIRST ": PRINT 
  89. 1170  INVERSE : PRINT TT$"STRING:";: NORMAL : INPUT " ";V1$
  90. 1180  IF V1$ = ""  THEN 1220
  91. 1190 T = T +1:EM$(T) = V1$:TT$ = "NEXT ": IF T <Q(42)  THEN 1170
  92. 1220  IF T < >0  THEN 1240
  93. 1230  PRINT "REALLY? ";: GOSUB 690: IF YN$ = "Y"  THEN  RETURN 
  94. 1235  GOTO 1150
  95. 1240  PRINT : PRINT "SEARCH CHARACTER STRINGS WILL BE:": PRINT : FOR I = 1 TO T: PRINT I") '"EM$(I)"'": NEXT 
  96. 1250  PRINT : INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 1150
  97. 1260 S$(0,FL) = S$(C1,2):S$(1,FL) =  STR$(M): FOR I = 1 TO M: IF OE(I) <16  THEN S$(I +1,FL) = S$(OE(I),0): GOTO 1270
  98. 1265  IF OE(I) >15  AND OE(I) < = 15 +Q(44)  THEN S$(I +1,FL) = Q$(OE(I) -4): GOTO 1270
  99. 1267 S$(I +1,FL) = "AUTO DATE"
  100. 1270  NEXT :FL = FL +1:S$(0,FL) =  STR$(T): FOR I = 1 TO T:S$(I,FL) = EM$(I): NEXT 
  101. 1350  GOSUB 700: RETURN 
  102. 1500  FOR X5 = 1 TO T:T$ = EM$(X5): IF OP(7)  THEN  GOSUB 1800
  103. 1502  FOR X6 = 1 TO M: IF OE(X6) >15 +Q(44)  THEN Z$ = RC$(11): GOTO 1520
  104. 1503  IF OE(X6) >15  THEN Z$ = RC$(OE(X6) -4): GOTO 1520
  105. 1504  IF OE(X6) >12  THEN Z$ = RC$(OE(X6) -5): GOTO 1520
  106. 1505  IF OE(X6) = 12  THEN 1700
  107. 1506  IF OE(X6) = 11  THEN 1650
  108. 1507  IF OE(X6) >6  THEN 1600
  109. 1508  IF OE(X6) >4  THEN Z$ = RC$(OE(X6) +1): GOTO 1520
  110. 1510 Z$ = RC$(OE(X6))
  111. 1520  IF C1 = 1  THEN 1524
  112. 1521  IF Z$ = T$  THEN FR = 1:X6 = M
  113. 1522  GOTO 1750
  114. 1524  IF  LEN(T$) > LEN(Z$)  THEN 1750
  115. 1525  IF OP(7)  THEN  GOSUB 1820
  116. 1530  FOR X7 = 1 TO  LEN(Z$) - LEN(T$) +1
  117. 1540  IF  MID$ (Z$,X7, LEN(T$)) = T$  THEN FR = 1:X7 = 1000
  118. 1550  NEXT : IF FR  THEN X6 = M
  119. 1560  GOTO 1750
  120. 1600  IF MG = 0  THEN 1750
  121. 1605  FOR X7 = 1 TO MG:Z$ = MI$(OE(X6) -6,X7): IF C1 = 1  THEN 1608
  122. 1606  IF T$ = Z$  THEN FR = 1:X7 = MG
  123. 1607  GOTO 1640
  124. 1608  IF  LEN(T$) > LEN(Z$)  THEN 1640
  125. 1609  IF OP(7)  THEN  GOSUB 1820
  126. 1610  FOR X8 = 1 TO  LEN(Z$) - LEN(T$) +1
  127. 1620  IF  MID$ (Z$,X8, LEN(T$)) = T$  THEN FR = 1:X8 = 1000
  128. 1630  NEXT : IF FR  THEN X7 = MG
  129. 1640  NEXT : IF FR  THEN X6 = M
  130. 1645  GOTO 1750
  131. 1650  IF CN = 0  THEN 1750
  132. 1655  FOR X7 = 1 TO CN: IF C1 = 1  THEN 1658
  133. 1656  IF T$ = C$(X7)  THEN FR = 1:X7 = CN
  134. 1657  GOTO 1680
  135. 1658  IF  LEN(T$) > LEN(C$(X7))  THEN 1680
  136. 1659 Z$ = C$(X7): IF OP(7)  THEN  GOSUB 1820
  137. 1660  FOR X8 = 1 TO  LEN(Z$) - LEN(T$) +1: IF  MID$ (Z$,X8, LEN(T$)) = T$  THEN FR = 1:X8 = 1000
  138. 1670  NEXT : IF FR  THEN X7 = CN
  139. 1680  NEXT : IF FR  THEN X6 = M
  140. 1690  GOTO 1750
  141. 1700  IF NT = 0  THEN 1750
  142. 1705  FOR X7 = 1 TO NT:Z$ = EX$(X7): IF C1 = 1  THEN 1708
  143. 1706  IF T$ = Z$  THEN FR = 1:X7 = NT
  144. 1707  GOTO 1740
  145. 1708  IF  LEN(T$) > LEN(Z$)  THEN 1740
  146. 1709  IF OP(7)  THEN  GOSUB 1820
  147. 1710  FOR X8 = 1 TO  LEN(Z$) - LEN(T$) +1
  148. 1720  IF  MID$ (Z$,X8, LEN(T$)) = T$  THEN FR = 1:X8 = 1000
  149. 1730  NEXT : IF FR  THEN X7 = NT
  150. 1740  NEXT : IF FR  THEN X6 = M
  151. 1750  NEXT : IF FR  THEN X5 = T
  152. 1760  NEXT : RETURN 
  153. 1800  IF T$ = ""  THEN  RETURN 
  154. 1802 A$ = T$:T$ = "": FOR I = 1 TO  LEN(A$): IF  ASC( MID$ (A$,I,1)) >95  THEN T$ = T$ + CHR$( ASC( MID$ (A$,I,1)) -32): GOTO 1810
  155. 1805 T$ = T$ + MID$ (A$,I,1)
  156. 1810  NEXT : RETURN 
  157. 1820  IF Z$ = ""  THEN  RETURN 
  158. 1825 A$ = Z$:Z$ = "": FOR I = 1 TO  LEN(A$): IF  ASC( MID$ (A$,I,1)) >95  THEN Z$ = Z$ + CHR$( ASC( MID$ (A$,I,1)) -32): GOTO 1835
  159. 1830 Z$ = Z$ + MID$ (A$,I,1)
  160. 1835  NEXT : RETURN 
  161. 1900  IF AA$ = ""  THEN 1945
  162. 1910 LB = 0: FOR I =  LEN(AA$) TO 1  STEP  -1: IF  MID$ (AA$,I,1) = Q$(4)  THEN LB = I:I = 1
  163. 1920  NEXT :FM$ = "": IF LB >0  THEN FM$ =  RIGHT$(AA$, LEN(AA$) -LB +1)
  164. 1930  IF LB >1  THEN AA$ =  LEFT$(AA$,LB -1)
  165. 1940  IF LB = 1  THEN AA$ = ""
  166. 1945 AA =  VAL(AA$): RETURN 
  167. 2000 W = X: GOSUB 2600
  168. 2010  IF  LEN(NA$(X -PA(IP) +Q(36) *IP)) < = 3  THEN  RETURN 
  169. 2012  IF Q(43) = 0  OR Q(41)  THEN  VTAB 1
  170. 2015  HTAB 15: PRINT "SEARCHING ID="X: POKE 34,2
  171. 2020  GOSUB 4100
  172. 2030 FR = 0: ON C1 GOSUB 1500,3400,5500,8500,1500
  173. 2210  IF   NOT FR  AND (C3 = 2  OR C3 = 4)  THEN SV(XZ) = 0
  174. 2215  IF   NOT FR  THEN  RETURN 
  175. 2220  IF Q(43) = 0  OR Q(41)  THEN  VTAB TB:TB = TB +1: IF TB >24  THEN TB = 24
  176. 2230 W = X: GOSUB 100
  177. 2232 IX = 0: GOSUB 350
  178. 2250  PRINT : IF LO <G(10)  AND C3 < >2  AND C3 < >4  THEN LO = LO +1:SV(LO) = X
  179. 2260  RETURN 
  180. 2300  IF LO <1  THEN 2380
  181. 2330  FOR I = 1 TO LO
  182. 2335  IF SV(I) < >0  THEN 2370
  183. 2340  IF LO = I  THEN 2365
  184. 2345  FOR J = I +1 TO LO:SV(J -1) = SV(J): NEXT 
  185. 2365 LO = LO -1: IF I < = LO  THEN 2335
  186. 2370  NEXT : IF LO = 0  THEN  PRINT "NONE FOUND": FOR I = 1 TO 5000: NEXT 
  187. 2380  RETURN 
  188. 2500 BB = 0: FOR I = 1 TO Q(8): IF WH(I,0) > -1  THEN  IF W >WH(I,0)  AND W < = WH(I,0) +G(2)  THEN BB = I:I = Q(8)
  189. 2510  NEXT : IF BB >0  THEN  RETURN 
  190. 2515  FOR I = 1 TO Q(8): IF WH(I,0) <0  AND X1 < >I  THEN BB = I:I = Q(8)
  191. 2517  NEXT : IF BB >0  THEN 2535
  192. 2520 A =  -1: FOR I = 1 TO Q(8): IF WH(I,0) > -1  THEN  IF A <WH(I,1)  THEN A = WH(I,1):BB = I
  193. 2530  NEXT : IF BB <1  THEN BB = 1: IF BB = X1  THEN BB = 2
  194. 2535  IF JR  THEN  GOSUB 600:X2 = 1
  195. 2540  PRINT : PRINT "PLEASE PLACE DISKETTE NUMBER "; INT((W -1)/G(2)) +1: PRINT "INTO DRIVE "BB
  196. 2550  PRINT : PRINT "TYPE ANY KEY WHEN READY";: GOSUB 690: IF YN$ < >CZ$  AND YN$ < >"N"  THEN 2560
  197. 2552  ONERR  GOTO 2558
  198. 2554  POP : GOTO 2554
  199. 2558  POKE 216,0: GOTO 20000
  200. 2560  GOSUB 850: ONERR  GOTO 2900
  201. 2570  PRINT  CHR$(4)"OPEN CONTROLS,S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"READ CONTROLS"
  202. 2580  INPUT WH(BB,0): PRINT  CHR$(4)"CLOSE CONTROLS":WH(BB,1) = 0: POKE 216,0
  203. 2590  GOTO 2500
  204. 2600  IF W = 0  THEN  RETURN 
  205. 2610 IP =  -1: FOR I = 0 TO Q(37) -1: IF PA(I) <W  AND W < = CT(I)  THEN IP = I:I = Q(37)
  206. 2620  NEXT : IF IP > -1  THEN SC(IP) = SC(IP) +1: RETURN 
  207. 2630 BB =  -1: FOR I = 0 TO Q(37) -1: IF BB <SC(I)  THEN BB = SC(I):IP = I
  208. 2635  NEXT : FOR I = 1 TO Q(8): IF WH(I,0) > -1  THEN  IF WH(I,0) < = PA(IP)  AND PA(IP) <WH(I,0) +G(2)  THEN WH(I,1) = WH(I,1) +SC(IP):I = Q(8)
  209. 2640  NEXT :X2 = 0: GOSUB 2500
  210. 2880  PRINT  CHR$(4)"OPEN NAMELIST,S"WH(BB,2)",D"WH(BB,3)",L"Q(36) *Q(14) +Q(38):OB =  INT((W -WH(BB,0) -1)/Q(36)) +1: PRINT  CHR$(4)"READ NAMELIST,R"OB: INPUT PA(IP): INPUT OB
  211. 2890  FOR I = Q(36) *IP +1 TO Q(36) *(IP +1): INPUT NA$(I): NEXT : PRINT  CHR$(4)"CLOSE NAMELIST":SC(IP) = 0:PA(IP) = PA(IP) +WH(BB,0):CT(IP) = PA(IP) +Q(36): IF JR  AND X2  THEN  GOSUB 580
  212. 2895  RETURN 
  213. 2900  POKE 216,0: CALL G(8): PRINT : PRINT "THAT WAS NOT A DATA DISKETTE.": PRINT "PLEASE TRY AGAIN...";: GET YN$: PRINT YN$: POKE  -16368,0: PRINT  CHR$(4)"OPEN CONTROLS": PRINT  CHR$(4)"READ CONTROLS": RESUME 
  214. 3000  GOSUB 850:L =  VAL(CH$(0)):X9 = 1: GOSUB 3300
  215. 3010  PRINT "DO YOU WANT TO:"
  216. 3020  PRINT : FOR I = 1 TO L: PRINT I") "CH$(I): NEXT 
  217. 3030  PRINT : INVERSE : PRINT "WHICH (1-"L")? ";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  218. 3040 C2 =  VAL(YN$): IF C2 <1  OR C2 >L  THEN 3030
  219. 3042 K = 0: IF Q(26)  THEN K = 1
  220. 3045 L =  VAL(S$(0,1)): IF C2 = 2  THEN  PRINT : PRINT "CHOOSE 2 DATE VARIABLES:": PRINT : GOTO 3060
  221. 3050  PRINT : PRINT "CHOOSE UP TO "L +IQ +K" DATE VARIABLES:": PRINT 
  222. 3060  FOR I = 1 TO L: PRINT I") "S$(I,1): NEXT : GOSUB 3350: IF Q(26)  THEN  PRINT L +IQ +1") AUTO DATE"
  223. 3070  PRINT :TT$ = "FIRST ":M = 0
  224. 3080  INVERSE : PRINT TT$"DATE NUMBER:";:: NORMAL : INPUT " ";V1$
  225. 3085  IF V1$ = ""  THEN 3100
  226. 3087 OG =  VAL(V1$): IF OG <1  OR OG >L +IQ +K  THEN 3080
  227. 3088 M = M +1:T(M) = OG: IF C2 = 2  AND M = 2  THEN 3100
  228. 3090 TT$ = "NEXT ": IF C2 = 2  THEN TT$ = "SECOND "
  229. 3095  IF M <L +IQ +K  THEN 3080
  230. 3100  IF M = 0  THEN  RETURN 
  231. 3105  PRINT : PRINT "YOU HAVE CHOSEN:": PRINT : FOR X5 = 1 TO M: PRINT T(X5)") ";: IF T(X5) >L  AND T(X5) < = L +IQ  THEN  GOSUB 3370: PRINT A$: GOTO 3110
  232. 3107  IF T(X5) >L +IQ  THEN  PRINT "AUTO DATE": GOTO 3110
  233. 3108  PRINT S$(T(X5),1)
  234. 3110  NEXT : PRINT : INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 3045
  235. 3112  FOR X5 = 1 TO M:JJ = 1: IF T(X5) >1  THEN JJ = 3
  236. 3114  IF T(X5) >L  AND T(X5) < = L +IQ  THEN  GOSUB 3370:JJ = A
  237. 3116  IF T(X5) >L +IQ  THEN JJ = 11
  238. 3118 OE(X5) = JJ: NEXT 
  239. 3120  IF C2 < >2  THEN 3130
  240. 3124  PRINT : INPUT "WHAT IS THE BRACKETED YEAR? ";EM$(1):T = 1
  241. 3126  IF EM$(1) = ""  THEN  RETURN 
  242. 3128  IF  LEN(EM$(1)) < >4  THEN  PRINT "INVALID ENTRY": GOTO 3124
  243. 3129  GOTO 3220
  244. 3130 T = 0:TT$ = "FIRST YEAR": IF C2 = 3  AND   NOT Q(25)  THEN TT$ = "FIRST MONTH/DAY (MMDD)"
  245. 3135  IF C2 = 3  AND Q(25)  THEN TT$ = "FIRST DAY/MONTH (DDMM)"
  246. 3140  PRINT : PRINT "CHOOSE THE SEARCH NUMBERS:": PRINT 
  247. 3150  INVERSE : PRINT TT$":";: NORMAL : INPUT " ";T$
  248. 3155  IF (C2 = 1  OR T = 0)  AND T$ = ""  THEN  RETURN 
  249. 3160  IF T$ = ""  THEN 3220
  250. 3162  IF  LEN(T$) = 4  THEN 3170
  251. 3164  IF C2 = 1  THEN  PRINT "INVALID YEAR": GOTO 3150
  252. 3166  IF  LEN(T$) < >2  OR  VAL(T$) <1  OR  VAL(T$) >12  THEN  PRINT "INVALID MONTH/DAY": GOTO 3150
  253. 3170 T = T +1:EM$(T) = T$
  254. 3180 TT$ = "SECOND YEAR": IF C2 = 3  AND   NOT Q(25)  THEN TT$ = "NEXT MONTH/DAY (MMDD)"
  255. 3182  IF C2 = 3  AND Q(25)  THEN TT$ = "NEXT DAY/MONTH (DDMM)"
  256. 3185  IF T = 2  AND C2 = 1  THEN 3220
  257. 3190  IF T <31  THEN 3150
  258. 3220  PRINT : PRINT "YOU HAVE CHOSEN:": PRINT : FOR I = 1 TO T: PRINT I") "EM$(I): NEXT 
  259. 3230  PRINT : INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 3130
  260. 3240 S$(0,FL) = CH$(C2):S$(1,FL) =  STR$(M):L =  VAL(S$(0,1)): FOR X5 = 1 TO M: IF T(X5) >L  AND T(X5) < = L +IQ  THEN  GOSUB 3370:S$(X5 +1,FL) = A$: GOTO 3250
  261. 3242  IF T(X5) >L +IQ  THEN S$(X5 +1,FL) = "AUTO DATE": GOTO 3250
  262. 3245 S$(X5 +1,FL) = S$(T(X5),1)
  263. 3250  NEXT :FL = FL +1:S$(0,FL) =  STR$(T): FOR I = 1 TO T:S$(I,FL) = EM$(I): NEXT 
  264. 3290  GOSUB 700: RETURN 
  265. 3300 IQ = 0: IF Q(44) <1  THEN  RETURN 
  266. 3305  FOR I = 12 TO 11 +Q(44): IF DF(I) = X9  THEN IQ = IQ +1
  267. 3310  NEXT : RETURN 
  268. 3350  IF IQ = 0  THEN  RETURN 
  269. 3355 A = L: FOR I = 1 TO Q(44): IF DF(I +11) = X9  THEN A = A +1: PRINT A") "Q$(I +11)
  270. 3360  NEXT : RETURN 
  271. 3370 A = T(X5) -L: FOR I = 1 TO Q(44): IF DF(I +11) = X9  THEN A = A -1
  272. 3375  IF A = 0  THEN A$ = Q$(I +11):A = I +11:I = Q(44)
  273. 3380  NEXT : RETURN 
  274. 3400  ON C2 GOSUB 3410,3600,3800: RETURN 
  275. 3410 Y1 =  VAL(EM$(1)):Y2 =  VAL(EM$(2)): IF Y1 >Y2  THEN AA = Y1:Y1 = Y2:Y2 = AA
  276. 3412  FOR X5 = 1 TO M: IF T(X5) < >3  THEN Z$ = RC$(OE(X5))
  277. 3416  IF T(X5) = 3  AND MG = 0  THEN 3550
  278. 3417  IF T(X5) = 3  THEN  FOR X6 = 1 TO MG:Z$ = MI$(2,X6)
  279. 3418  IF  MID$ (Z$,9,1) = Q$(4)  THEN Z$ =  LEFT$(Z$,8)
  280. 3420  IF  LEN(Z$) < >8  THEN 3545
  281. 3430 Z$ =  RIGHT$(Z$,4):OD =  VAL(Z$): IF OD <1000  THEN AA$ = Z$: GOSUB 3900:OD = AA
  282. 3440  IF OD > = Y1  AND OD < = Y2  THEN FR = 1:X6 = MG
  283. 3545  IF T(X5) = 3  THEN  NEXT 
  284. 3548  IF FR  THEN X5 = M
  285. 3550  NEXT : RETURN 
  286. 3600 OD =  VAL(EM$(1)): IF T(1) < >3  THEN Z$ = RC$(OE(1)): GOTO 3608
  287. 3601  IF MG = 0  THEN 3750
  288. 3602 Z$ = "": FOR X5 = 1 TO MG: IF  LEN(MI$(2,X5)) = 8  OR  MID$ (MI$(2,X5),9,1) = Q$(4)  THEN Z$ = MI$(2,X5):X5 = MG
  289. 3603  NEXT 
  290. 3608  IF  MID$ (Z$,9,1) = Q$(4)  THEN Z$ =  LEFT$(Z$,8)
  291. 3609  IF  LEN(Z$) < >8  THEN 3750
  292. 3610 Y1 =  VAL( RIGHT$(Z$,4)): IF Y1 <1000  THEN 3750
  293. 3620  IF T(2) < >3  THEN Z$ = RC$(OE(2)): GOTO 3627
  294. 3622  IF MG = 0  THEN 3750
  295. 3624 Z$ = "": FOR X5 = 1 TO MG: IF  LEN(MI$(2,X5)) = 8  OR  MID$ (MI$(2,X5),9,1) = Q$(4)  THEN Z$ = MI$(2,X5):X5 = MG
  296. 3626  NEXT 
  297. 3627  IF Z$ = "L"  OR  LEFT$(Z$,2) = "L" +Q$(4)  THEN Y2 = 10000: GOTO 3640
  298. 3628  IF  MID$ (Z$,9,1) = Q$(4)  THEN Z$ =  LEFT$(Z$,8)
  299. 3629  IF  LEN(Z$) < >8  THEN 3750
  300. 3630 Y2 =  VAL( RIGHT$(Z$,4)): IF Y2 <1000  THEN 3750
  301. 3640  IF Y1 >Y2  THEN AA = Y1:Y1 = Y2:Y2 = AA
  302. 3650  IF OD > = Y1  AND OD < = Y2  THEN FR = 1
  303. 3750  RETURN 
  304. 3800  FOR X5 = 1 TO M: IF T(X5) < >3  THEN Z$ = RC$(OE(X5)): GOTO 3808
  305. 3802  IF MG = 0  THEN 3890
  306. 3804  FOR X7 = 1 TO MG:Z$ = MI$(2,X7)
  307. 3808  IF  MID$ (Z$,9,1) = Q$(4)  THEN Z$ =  LEFT$(Z$,8)
  308. 3809  IF  LEN(Z$) < >8  THEN 3860
  309. 3810  FOR X6 = 1 TO T:T$ = EM$(X6):X8 = 0
  310. 3820  IF  LEN(T$) = 2  THEN X8 = 2: GOTO 3840
  311. 3822  IF  VAL( LEFT$(T$,2)) >0  AND  VAL( RIGHT$(T$,2)) >0  THEN X8 = 4: GOTO 3840
  312. 3825  IF  VAL( RIGHT$(T$,2)) = 0  THEN X8 = 2: GOTO 3840
  313. 3830  IF  RIGHT$(T$,2) =  MID$ (Z$,3,2)  THEN FR = 1:X6 = T:X7 = MG: GOTO 3850
  314. 3840  IF X8 >0  THEN  IF  LEFT$(T$,X8) =  LEFT$(Z$,X8)  THEN FR = 1:X6 = T:X7 = MG
  315. 3850  NEXT 
  316. 3860  IF T(X5) = 3  THEN  NEXT 
  317. 3870  IF FR  THEN X5 = M
  318. 3890  NEXT : RETURN 
  319. 3900 AA = 0
  320. 3910  FOR X8 = 1 TO 4: IF  MID$ (AA$,X8,1) <"0"  OR  MID$ (AA$,X8,1) >"9"  THEN 3950
  321. 3920 AA = AA + VAL( MID$ (AA$,X8,1)) *10 ^(4 -X8)
  322. 3950  NEXT : RETURN 
  323. 4100 W = X: GOSUB 2500
  324. 4102  ONERR  GOTO 4300
  325. 4105  PRINT  CHR$(4)"OPEN FAMILY,L"Q(16)",S"WH(BB,2)",D"WH(BB,3)
  326. 4110  PRINT  CHR$(4)"READ FAMILY,R"X -WH(BB,0)
  327. 4115  FOR I = 1 TO 10: INPUT RC$(I)
  328. 4120  NEXT :AA$ = RC$(8): GOSUB 1900:MG = AA: IF MG >0  THEN  FOR I = 1 TO MG: FOR J = 1 TO 4: INPUT MI$(J,I): NEXT : NEXT 
  329. 4123 AA$ = RC$(9): GOSUB 1900:CN = AA: IF CN >0  THEN  FOR I = 1 TO CN: INPUT C$(I): NEXT 
  330. 4125 AA$ = RC$(10): GOSUB 1900:NT = AA: IF NT >0  THEN  FOR I = 1 TO NT: INPUT EX$(I): NEXT 
  331. 4130  FOR I = 11 TO 20: INPUT RC$(I): NEXT 
  332. 4140  PRINT  CHR$(4)"CLOSE": POKE 216,0
  333. 4180  RETURN 
  334. 4300 A =  PEEK(222): POKE 216,0: CALL G(8): IF A < >6  THEN 4320
  335. 4305  PRINT "LOAD DATA DISKETTE IN DRIVE "BB: PRINT "TYPE ANY KEY WHEN READY";: GOSUB 690
  336. 4310  PRINT  CHR$(4)"OPEN FAMILY,L"Q(16)",S"WH(BB,2)",D"WH(BB,3): PRINT  CHR$(4)"READ FAMILY,R"X -WH(BB,0): RESUME 
  337. 4320  IF A < >5  AND A < >8  AND A < >254  THEN 11110
  338. 4330  PRINT "DATA ERROR IN RECORD "X: FOR I = 1 TO 3000: NEXT : GOTO 2552
  339. 5000  GOSUB 850:L =  VAL(VR$(0)):X9 = 2: GOSUB 3300
  340. 5010  PRINT : INVERSE : PRINT "DO YOU WANT TO SEARCH ALL NAMES IN EACH": PRINT "RECORD? ";: GOSUB 690
  341. 5020  IF YN$ = "Y"  THEN T = 4 +IQ: FOR I = 1 TO T:T(I) = I: NEXT : GOTO 5110
  342. 5030  PRINT : PRINT "CHOOSE THE NAME VARIABLES TO SEARCH:": PRINT 
  343. 5040  FOR I = 1 TO L: PRINT I") "VR$(I): NEXT : GOSUB 3350
  344. 5050 TT$ = "FIRST ":T = 0: PRINT 
  345. 5060  INVERSE : PRINT TT$"NUMBER:";: NORMAL : INPUT " ";T$
  346. 5070  IF T$ = ""  THEN 5100
  347. 5080 PB =  VAL(T$): IF PB <1  OR PB >L +IQ  THEN 5060
  348. 5090 T = T +1:T(T) = PB:TT$ = "NEXT ": IF T <L +IQ  THEN 5060
  349. 5100  IF T = 0  THEN  RETURN 
  350. 5110  FOR X5 = 1 TO T: IF T(X5) >L  THEN  GOSUB 3370:OE(X5) = A: GOTO 5120
  351. 5112  IF T(X5) >2  THEN OE(X5) = T(X5) -2: GOTO 5120
  352. 5115 OE(X5) = T(X5) +5
  353. 5120  NEXT : PRINT : PRINT "YOU HAVE CHOSEN:": PRINT : FOR X5 = 1 TO T: PRINT T(X5)") ";: IF T(X5) >L  THEN  GOSUB 3370: PRINT A$: GOTO 5130
  354. 5125  PRINT VR$(T(X5))
  355. 5130  NEXT : PRINT : INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 5030
  356. 5150  PRINT : PRINT "CHOOSE UP TO "Q(42)" NAMES TO SEARCH": PRINT "FOR, BY NUMBER OR EXACT NAME."
  357. 5160 TT$ = "FIRST ":M = 0
  358. 5170  PRINT : INVERSE : PRINT TT$"NUMBER OR NAME:";: NORMAL : INPUT " ";V1$
  359. 5180 I = 1: IF V1$ = ""  THEN 5240
  360. 5185  IF  VAL(V1$) >G(2)  OR  VAL(V1$) <1  THEN  PRINT "THE DEMO DISK CAN ONLY ACCOMMODATE";: GOSUB 860: PRINT G(2)" NAMES.": PRINT : GOTO 5170
  361. 5190  IF  MID$ (V1$,I,1) = " "  THEN I = I +1: GOTO 5190
  362. 5200  IF  MID$ (V1$,I,1) <"0"  OR  MID$ (V1$,I,1) >"9"  THEN 5230
  363. 5210 OG =  VAL(V1$): PRINT :W = OG: GOSUB 100
  364. 5215  PRINT "THAT IS THE NUMBER FOR:": PRINT  SPC( 4);:IX = 4: GOSUB 350
  365. 5220  PRINT : INVERSE : PRINT "USE IT? ";: GOSUB 690: IF YN$ = "N"  THEN 5170
  366. 5230 M = M +1:EM$(M) = V1$:TT$ = "NEXT ": IF M <Q(42)  THEN 5170
  367. 5240  IF M = 0  THEN  RETURN 
  368. 5270  PRINT : INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 5150
  369. 5340 L =  VAL(VR$(0)):S$(0,FL) = S$(3,2):S$(1,FL) =  STR$(T): FOR X5 = 1 TO T: IF T(X5) >L  THEN  GOSUB 3370:S$(X5 +1,FL) = A$: GOTO 5360
  370. 5350 S$(X5 +1,FL) = VR$(T(X5))
  371. 5360  NEXT :FL = FL +1:S$(0,FL) =  STR$(M): FOR I = 1 TO M:S$(I,FL) = EM$(I): NEXT 
  372. 5450  GOSUB 700: RETURN 
  373. 5500  FOR X5 = 1 TO M
  374. 5510  FOR X6 = 1 TO T: IF OE(X6) <6  THEN  ON OE(X6) GOTO 5540,5560
  375. 5530 AA$ = RC$(OE(X6)): GOSUB 1900: IF EM$(X5) = AA$  OR ( VAL(EM$(X5)) = AA  AND AA >0)  THEN FR = 1
  376. 5535  GOTO 5580
  377. 5540  IF MG = 0  THEN 5580
  378. 5545  FOR X7 = 1 TO MG:AA$ = MI$(1,X7): GOSUB 1900: IF EM$(X5) = AA$  OR ( VAL(EM$(X5)) = AA  AND AA >0)  THEN FR = 1:X7 = MG
  379. 5550  NEXT : GOTO 5580
  380. 5560  IF CN = 0  THEN 5580
  381. 5565  FOR X7 = 1 TO CN:AA$ = C$(X7): GOSUB 1900: IF EM$(X5) = AA$  OR ( VAL(EM$(X5)) = AA  AND AA >0)  THEN FR = 1:X7 = CN
  382. 5570  NEXT 
  383. 5580  IF FR  THEN X6 = T:X5 = M
  384. 5585  NEXT : NEXT : RETURN 
  385. 5600 B$ = "": IF A$ = ""  THEN  RETURN 
  386. 5610  FOR I = 1 TO  LEN(A$): IF  ASC( MID$ (A$,I,1)) >95  THEN B$ = B$ + CHR$( ASC( MID$ (A$,I,1)) -32): GOTO 5630
  387. 5620 B$ = B$ + MID$ (A$,I,1)
  388. 5630  NEXT : RETURN 
  389. 6000  PRINT S$(C1,2): PRINT "BY "H1$(2):TB = 0:B$ = "FIRST "
  390. 6010  PRINT B$;: INPUT "NUMBER? ";A$: IF A$ = ""  THEN 6050
  391. 6030 A =  VAL(A$): IF A <1  OR A >G(2)  THEN  PRINT "OUT OF RANGE.  ID'S MUST BE BETWEEN 1";: GOSUB 860: PRINT "AND "G(2)".": GOTO 6010
  392. 6040 LO = LO +1:SV(LO) = A:B$ = "NEXT ": IF LO <Q(24)  THEN 6010
  393. 6050  IF LO = 0  THEN  RETURN 
  394. 6060  GOSUB 850:TB = 3
  395. 6070  FOR XZ = 1 TO LO:X = SV(XZ)
  396. 6090  GOSUB 2000
  397. 6110  GOSUB 990: NEXT XZ
  398. 6120  RETURN 
  399. 6200  INPUT "START NUMBER? ";A$: IF A$ = ""  THEN  RETURN 
  400. 6210 X3 =  VAL(A$): IF X3 <1  THEN X3 = 1
  401. 6215  IF X3 >G(2)  THEN  PRINT : PRINT "THE DEMO DISK CAN ONLY ACCOMMODATE";: GOSUB 860: PRINT G(2)" NAMES.": PRINT : GOTO 6200
  402. 6220  INPUT "END NUMBER? ";A$:X4 =  VAL(A$): IF X4 = 0  THEN X4 = X3
  403. 6227  IF X4 >G(2)  THEN  PRINT : PRINT "THE DEMO DISK CAN ONLY ACCOMMODATE";: GOSUB 860: PRINT G(2)" NAMES.": PRINT : GOTO 6220
  404. 6230  GOSUB 850:TB = 3
  405. 6240  PRINT : FOR XZ = X3 TO X4:X = XZ:
  406. 6260  GOSUB 2000
  407. 6280  GOSUB 990: NEXT 
  408. 6290  RETURN 
  409. 6400  GOSUB 850: PRINT S$(C1,2): PRINT : PRINT : INVERSE : PRINT "DEFINING HEADER:": NORMAL : PRINT : POKE 34,5: IF Q(9) >0  THEN  CALL G(0)
  410. 6405  IF R >0  THEN  PRINT "USE PREVIOUSLY DEFINED HEADER?";: GOSUB 690: PRINT :OP(6) = (YN$ < >CZ$): IF YN$ = "Y"  OR YN$ = CZ$  THEN  POKE 34,0: RETURN 
  411. 6410 R = 0: INPUT "HOW MANY BLANK LINES AT THE TOP?";YN$: IF YN$ = ""  THEN 6450
  412. 6420 R =  VAL(YN$): IF R <0  THEN R = 0
  413. 6430  IF R >Q(18) -2  THEN 6410
  414. 6440  IF R >0  THEN  FOR I = 1 TO R:G$(I) = "": NEXT 
  415. 6450  PRINT : PRINT "TYPE UP TO "Q(18) -R" LINES.  USE 'RETURN'": PRINT "TO END:"
  416. 6460  PRINT :R = R +1: PRINT "LINE "R;: INPUT ": ";G$(R): IF G$(R) < >""  AND R <Q(18) -1  THEN 6460
  417. 6470 R = R -1: PRINT : INPUT "HOW MANY BLANK LINES TO FOLLOW?";YN$: IF YN$ = ""  THEN R = R +1:G$(R) = "": GOTO 6510
  418. 6480 A =  VAL(YN$): IF A <0  THEN 6510
  419. 6490  IF A >Q(18) -R  THEN A = Q(18) -R
  420. 6500  IF A >0  THEN  FOR I = R +1 TO R +A:G$(I) = "": NEXT :R = R +A
  421. 6510  GOSUB 850:AA = FC:FC = Q(22): PRINT "YOUR HEADER IS:": PRINT : FOR X5 = 1 TO R: PRINT "LINE "X5": ";:IX = 7: GOSUB 6700: NEXT :FC = AA
  422. 6520  PRINT : PRINT "IS IT O.K.?";: GOSUB 690: IF YN$ < > CHR$(13)  AND YN$ < >"Y"  THEN  GOSUB 850: GOTO 6410
  423. 6530  PRINT : PRINT "SET PARAMETERS (DON'T FORGET THE TAB)?";: GOSUB 690: POKE 34,0: IF YN$ = "Y"  OR YN$ = "P"  THEN  GOSUB 9000
  424. 6540  RETURN 
  425. 6600  IF R = 0  THEN  RETURN 
  426. 6610  FOR X5 = 1 TO R: PRINT  SPC( OP(5));:IX = OP(5): GOSUB 6700: NEXT :LC = R: RETURN 
  427. 6700  IF  LEN(G$(X5)) +IX < = FC  THEN  PRINT G$(X5): RETURN 
  428. 6730 JJ = 0: FOR I = FC -IX TO 1  STEP  -1: IF  MID$ (G$(X5),I,1) = " "  OR  MID$ (G$(X5),I,1) = "-"  THEN JJ = I:I = 1
  429. 6735  NEXT : PRINT  LEFT$(G$(X5),JJ): PRINT  SPC( IX) RIGHT$(G$(X5), LEN(G$(X5)) -JJ):LC = LC +1: RETURN 
  430. 6760  GOSUB 850: PRINT : PRINT "1) RUN A DIFFERENT PROGRAM": PRINT "2) CHECK FREE SPACE": PRINT "3) RETURN TO 'SEARCH'": PRINT "4) END SESSION"
  431. 6762  PRINT : INVERSE : PRINT "CHOICE (1-4)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  GOTO 6780
  432. 6764 C1 =  VAL(YN$): IF C1 <1  OR C1 >4  THEN 6762
  433. 6766  IF C1 = 4  THEN  PRINT Q$(21): PRINT "BYE...": END 
  434. 6768  ON C1 GOTO 6780,6770,12120
  435. 6770  PRINT "FREE SPACE=" FRE(0): GOSUB 690: GOTO 6760
  436. 6780 A = 0:X =  -1: FOR I = 1 TO Q(8): IF WH(I,0) =  -3  THEN A = A +1:X = I
  437. 6781  NEXT : IF A = 1  THEN 6783
  438. 6782  POKE 216,0:X = Q(29)
  439. 6783  GOSUB 850: IF YN$ = CZ$  THEN  PRINT  CHR$(4)"PR#"Q(43): GOTO 6760
  440. 6784  IF Q(40)  THEN  PRINT  CHR$(21)
  441. 6785 A = WH(X,2): GOSUB 9500: PRINT "LOADING NEXT MODULE"
  442. 6787  ONERR  GOTO 6782
  443. 6790  PRINT  CHR$(4)"BLOAD CHAIN,A520,S"A",D"WH(X,3): POKE 216,0: CALL 520"PROGRAMS"
  444. 6795 X = 1: GOSUB 850: RETURN 
  445. 6800  IF Q(9) >0  THEN  CALL G(0)
  446. 6810  PRINT S$(C1,2): PRINT "HAVING ALL THE FOLLOWING-ENTERED NAMES": PRINT "IN COMMON:": PRINT  SPC( 4)"--LAST NAME AT BIRTH";: INPUT NL$
  447. 6820  PRINT  TAB( 5)"--FIRST NAME(S)";: INPUT NF$: PRINT  TAB( 5)"--MARRIED NAME";: INPUT NM$: PRINT 
  448. 6830  IF NF$ +NL$ +NM$ = ""  THEN  RETURN 
  449. 6840  IF OP(7)  THEN A$ = NF$: GOSUB 5600:NF$ = B$:A$ = NL$: GOSUB 5600:NL$ = B$:A$ = NM$: GOSUB 5600:NM$ = B$
  450. 6845  GOSUB 850:TB = 3
  451. 6850  FOR XY = 1 TO Q(8): IF WH(XY,0) <0  THEN 6960
  452. 6860  PRINT : FOR XZ = 1 TO G(2):W = XZ +WH(XY,0): GOSUB 100
  453. 6865  IF NL$ = ""  THEN 6880
  454. 6867  IF OP(7)  THEN A$ = N2$: GOSUB 5600:N2$ = B$
  455. 6870  IF NL$ < >N2$  THEN 6950
  456. 6880  IF NM$ = ""  THEN 6900
  457. 6885  IF OP(7)  THEN A$ = N3$: GOSUB 5600:N3$ = B$
  458. 6890  IF NM$ < >N3$  THEN 6950
  459. 6900  IF NF$ = ""  THEN 6920
  460. 6905  IF OP(7)  THEN A$ = N1$: GOSUB 5600:N1$ = B$
  461. 6910 Z = 0:AA$ = N1$:BB$ = NF$: GOSUB 7840: IF Z = 0  THEN 6950
  462. 6920 X = XZ
  463. 6930  GOSUB 2000
  464. 6950  GOSUB 990: NEXT XZ
  465. 6960  NEXT XY
  466. 6970  RETURN 
  467. 7000  GOSUB 850:L =  VAL(WR$(0)):X9 = 3: GOSUB 3300
  468. 7010  PRINT : PRINT "CHOOSE THE NUMBER VARIABLES TO SEARCH:": PRINT 
  469. 7020  FOR I = 1 TO L: PRINT I") "WR$(I): NEXT : GOSUB 3350
  470. 7030 TT$ = "FIRST ":T = 0: PRINT 
  471. 7040  INVERSE : PRINT TT$"NUMBER:";: NORMAL : INPUT " ";T$
  472. 7050  IF T$ = ""  THEN 7080
  473. 7060 PB =  VAL(T$): IF PB <1  OR PB >L +IQ  THEN 7040
  474. 7070 T = T +1:T(T) = PB:TT$ = "NEXT ": IF T <L +IQ  THEN 7040
  475. 7080  IF T = 0  THEN  RETURN 
  476. 7090  FOR X5 = 1 TO T: IF T(X5) >L  THEN  GOSUB 3370:OE(X5) = A: GOTO 7100
  477. 7095 OE(X5) = T(X5) +7
  478. 7100  NEXT : PRINT : PRINT "YOU HAVE CHOSEN:": PRINT : FOR X5 = 1 TO T: PRINT T(X5)") ";: IF T(X5) >L  THEN  GOSUB 3370: PRINT A$: GOTO 7110
  479. 7105  PRINT WR$(T(X5))
  480. 7110  NEXT : PRINT : INVERSE : PRINT "OK TO CONTINUE?";: GOSUB 690: IF YN$ = "N"  THEN 7010
  481. 7120 :
  482. 7200  PRINT : PRINT "CHOOSE UP TO "Q(42)" NUMERICAL VALUES TO": PRINT "SEARCH FOR."
  483. 7210 TT$ = "FIRST ":M = 0: PRINT 
  484. 7220  INVERSE : PRINT TT$"NUMBER:";: NORMAL : INPUT " ";V1$
  485. 7230  IF V1$ = ""  THEN 7250
  486. 7240 M = M +1:OD(M) =  INT( VAL(V1$)):TT$ = "NEXT ": IF M <Q(42)  THEN 7220
  487. 7250  IF M = 0  THEN  RETURN 
  488. 7260  PRINT : PRINT "YOU HAVE CHOSEN:": PRINT : FOR I = 1 TO M: PRINT  TAB( 4)OD(I): NEXT : PRINT 
  489. 7270  INVERSE : PRINT "OK TO CONTINUE? ";: GOSUB 690: IF YN$ = "N"  THEN 7200
  490. 7340 L =  VAL(WR$(0)):S$(0,FL) = S$(4,2):S$(1,FL) =  STR$(T): FOR X5 = 1 TO T: IF T(X5) >L  THEN  GOSUB 3370:S$(X5 +1,FL) = A$: GOTO 7350
  491. 7345 S$(X5 +1,FL) = WR$(T(X5))
  492. 7350  NEXT :FL = FL +1:S$(0,FL) =  STR$(M): FOR I = 1 TO M:S$(I,FL) =  STR$(OD(I)): NEXT 
  493. 7450  GOSUB 700: RETURN 
  494. 7500  IF C1 = 2  THEN  IF LO <1  THEN  PRINT "NOTHING IS SAVED IN MEMORY": FOR I = 1 TO 5000: NEXT : RETURN 
  495. 7503 A$ = "SEARCH": IF C1 = 2  THEN A$ = "OUTPUT"
  496. 7505  GOSUB 850: PRINT "CHOOSE THE TYPE OF "A$":": PRINT 
  497. 7510 L =  VAL(S$(0,C1 +1)): FOR I = 1 TO L: PRINT I") "S$(I,C1 +1): NEXT 
  498. 7520  PRINT : INVERSE : PRINT "WHICH (1-"L",P)?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  499. 7525  IF YN$ = "P"  THEN  GOSUB 9000: GOTO 7500
  500. 7530 GE =  VAL(YN$): IF GE <1  OR GE >L  THEN 7520
  501. 7535  IF C1 = 2  THEN 7550
  502. 7536 FL = FL +1: IF FL > = Q(20)  THEN FL = Q(20) -1
  503. 7540 C1 = GE: ON GE GOSUB 1000,3000,5000,7000,1000: RETURN 
  504. 7550  ON GE GOSUB 8000,8100,8200: RETURN 
  505. 7840 A =  LEN(AA$) - LEN(BB$)
  506. 7860  IF A <0  THEN Z = 0: RETURN 
  507. 7880 I = A +1
  508. 7900  IF BB$ =  MID$ (AA$,I, LEN(BB$))  THEN Z = I
  509. 7920 I = I -1: IF I >0  THEN 7900
  510. 7940  RETURN 
  511. 7960  RETURN 
  512. 8000 LC = 0:FC = Q(22):OP(8) = 0: FOR X = 1 TO LO:W = SV(X):LC = LC +1: IF  INT((LC -1)/20) *20 < >LC -1  THEN 8020
  513. 8005 A$ = "": IF FL >6  THEN A$ = "ES"
  514. 8010  GOSUB 850: PRINT "THE FOLLOWING NAMES IN MEMORY SATISFIED": PRINT "THE SEARCH"A$" THAT YOU HAVE DONE:": PRINT 
  515. 8020 BB = 0: FOR I = 1 TO Q(8): IF WH(I,0) > -1  THEN  IF W >WH(I,0)  AND W < = WH(I,0) +G(2)  THEN BB = I:I = Q(8)
  516. 8022  NEXT : IF BB = 0  THEN  PRINT  SPC( 6 - LEN( STR$(W)))W") (NAME NOT AVAILABLE)": GOTO 8030
  517. 8025  GOSUB 100: PRINT  SPC( 6 - LEN( STR$(W)))W") ";:IX = 8: GOSUB 350: PRINT 
  518. 8030  IF  INT(LC/20) *20 = LC  THEN  PRINT "PRESS ANY KEY TO CONTINUE";: GOSUB 690: IF YN$ = CZ$  THEN X = LO
  519. 8040  NEXT : IF  INT(LC/20) *20 < >LC  THEN  PRINT "PRESS ANY KEY TO CONTINUE";: GOSUB 690
  520. 8050  RETURN 
  521. 8100 LC = 0:FC = Q(23) *Q(Q(6)):OP(8) = 0: IF OP(6)  THEN  GOSUB 6400
  522. 8105  GOSUB 580:JR = 1: IF OP(6)  THEN  GOSUB 6600: GOTO 8120
  523. 8110  GOSUB 9200
  524. 8120  FOR X = 1 TO LO:W = SV(X):LC = LC +1: IF X = 1  THEN 8125
  525. 8122  IF  INT((LC -1)/55) *55 < >LC -1  THEN 8130
  526. 8125  PRINT  SPC( OP(2) +4)"ID" SPC( 3)"NAME":LC = LC +2: PRINT 
  527. 8130  GOSUB 100
  528. 8140  PRINT  SPC( OP(2) +6 - LEN( STR$(W)))W") ";:IX = 8 +OP(2): GOSUB 350: PRINT 
  529. 8150  IF  INT(LC/55) *55 = LC  AND X < >LO  THEN  PRINT  CHR$(12)
  530. 8155 A =  PEEK( -16384): IF A >127  THEN  POKE  -16368,0: IF A =  ASC(CZ$) +128  THEN X = LO
  531. 8160  NEXT : IF OP(1)  THEN  PRINT  CHR$(12)
  532. 8170  GOSUB 600:JR = 0: RETURN 
  533. 8200  IF Q(8) <2  THEN  PRINT "NOT AVAILABLE FOR 1 DRIVE SYSTEM": FOR I = 1 TO 5000: NEXT : RETURN 
  534. 8205  GOSUB 850: HTAB (Q(22) - LEN(S$(3,3)))/2: INVERSE : PRINT S$(3,3): NORMAL 
  535. 8210  PRINT : PRINT "WHICH DISK DRIVE FOR OUTPUT (1-"Q(8)")?";: GOSUB 690: IF YN$ =  CHR$(13)  OR YN$ = CZ$  THEN  RETURN 
  536. 8220 DR =  VAL(YN$): IF DR <1  OR DR >Q(8)  THEN 8210
  537. 8225  PRINT : INPUT "WHAT DO YOU WANT TO CALL THE LIST?";B$: IF B$ = CZ$  THEN  RETURN 
  538. 8226  IF B$ = ""  THEN  GOSUB 8350: GOTO 8225
  539. 8227  IF  LEN(B$) >25  THEN B$ =  LEFT$(B$,25): PRINT : PRINT "THAT WAS SHORTENED TO": PRINT B$
  540. 8230  PRINT : PRINT "PRESS ANY KEY TO START";: GOSUB 690: IF YN$ = CZ$  THEN  RETURN 
  541. 8240 X1 = DR: ONERR  GOTO 8300
  542. 8250 WH(DR,0) =  -1: PRINT  CHR$(4)"OPEN "B$",S"WH(DR,2)",D"WH(DR,3)
  543. 8260  PRINT  CHR$(4)"WRITE "B$: PRINT LO: PRINT 0: PRINT  CHR$(4)
  544. 8270  FOR X = 1 TO LO:W = SV(X): GOSUB 2600
  545. 8280  PRINT  CHR$(4)"WRITE "B$: PRINT W: PRINT NA$(W -PA(IP) +Q(36) *IP): PRINT  CHR$(4)
  546. 8290  NEXT : PRINT  CHR$(4)"CLOSE": POKE 216,0: RETURN 
  547. 8300  POKE 216,0: CALL G(8):A =  PEEK(222): IF A = 4  OR A = 10  OR A = 13  THEN  PRINT "CAN'T WRITE TO THAT FILE.";: GOTO 8340
  548. 8310  IF A = 9  THEN  PRINT "DISK FULL.";: GOTO 8340
  549. 8320  IF A = 8  THEN  PRINT "I/O ERROR ON DISKETTE";: GOTO 8340
  550. 8330  PRINT "ERROR # "A". PLEASE SEE DOS MANUAL.";
  551. 8340 X = LO: GOSUB 690: GOTO 2552
  552. 8350 A$ = "CAT": IF Q(9) < >1  THEN A$ = "CATALOG"
  553. 8355  PRINT  CHR$(4)A$",S"WH(DR,2)",D"WH(DR,3): RETURN 
  554. 8500  FOR X5 = 1 TO T: IF RC$(OE(X5)) = ""  THEN 8600
  555. 8510 AA$ = RC$(OE(X5)): GOSUB 1900:PB = AA: FOR X6 = 1 TO M: IF PB = OD(X6)  THEN FR = 1:X6 = M:X5 = T
  556. 8520  NEXT 
  557. 8600  NEXT : RETURN 
  558. 9000  GOSUB 850: INVERSE : PRINT "SELECT PARAMETER BY LETTER:": NORMAL : PRINT 
  559. 9010  FOR I = 1 TO OP: PRINT  CHR$(64 +I)") "OP$(I)" (NOW "OP(I)")": IF  INT(I/4) *4 = I  THEN  PRINT 
  560. 9020  NEXT :J = OP: IF DY$ < >""  THEN J = J +1: PRINT  CHR$(64 +J)") DATE (NOW "DY$")": PRINT 
  561. 9030  PRINT "(NOTE: 0='FALSE',1='TRUE')"
  562. 9040  PRINT : INVERSE : PRINT "WHICH (A-" CHR$(64 +J)")?";: GOSUB 690: IF YN$ =  CHR$(13)  THEN  RETURN 
  563. 9090 A =  ASC(YN$) -64: IF A <1  OR A >J  THEN 9040
  564. 9100  IF J >OP  AND A = J  THEN 9140
  565. 9110  PRINT OP$(A)"?";: GET B$: POKE  -16368,0: PRINT B$;
  566. 9120  IF A < >2  AND A < >5  THEN 9130
  567. 9122  GET YN$: POKE  -16368,0: PRINT YN$;: IF YN$ =  CHR$(13)  THEN 9130
  568. 9124  IF YN$ < > CHR$(8)  THEN B$ = B$ +YN$: GOTO 9122
  569. 9126  IF  LEN(B$) >1  THEN B$ =  LEFT$(B$, LEN(B$) -1): GOTO 9122
  570. 9128 B$ = "": GOTO 9122
  571. 9130  IF B$ =  CHR$(13)  OR B$ = ""  THEN 9000
  572. 9135 OP(A) =  VAL(B$): GOTO 9000
  573. 9140  INPUT "DATE?";B$: IF B$ < >""  THEN DY$ = B$
  574. 9150  GOTO 9000
  575. 9200  FOR I = 5 TO FL  STEP 2: PRINT  SPC( OP(5))S$(0,I)":";:M =  VAL(S$(1,I)): IF I = 5  THEN  PRINT  SPC( 7)DY$;
  576. 9210  PRINT : FOR J = 1 TO M: PRINT  SPC( OP(5) +3)S$(J +1,I): NEXT :LC = LC +M +1:T =  VAL(S$(0,I +1))
  577. 9212  IF T = 1  AND S$(1,I +1) = ""  THEN 9230
  578. 9215  PRINT : PRINT  SPC( OP(5))"SEARCH FOR THE FOLLOWING VALUES:":LC = LC +2
  579. 9220  FOR J = 1 TO T: PRINT  SPC( OP(5) +3)S$(J,I +1): NEXT :LC = LC +T
  580. 9230  PRINT :LC = LC +1: NEXT : PRINT  SPC( OP(5))"RECORDS FOR THE FOLLOWING PEOPLE SATISFIED THE SEARCH:": PRINT :LC = LC +2: RETURN 
  581. 9500  GOSUB 850: FOR I = 1 TO 7: PRINT : NEXT : INVERSE : PRINT "PLEASE WAIT";: NORMAL : PRINT "...": PRINT : PRINT  SPC( 14);: RETURN 
  582. 10000  DATA 15
  583. 10010  DATA DATE OF BIRTH,PLACE OF BIRTH,DATE OF DEATH/LIVING,PLACE OF DEATH/LIVING
  584. 10012  DATA  MOTHER,FATHER,"SPOUSE(S)"
  585. 10015  DATA DATE(S) OF MARRIAGE,PLACE(S) OF MARRIAGE,MARITAL STATUS(ES),CHILDREN,NOTES,NUMBER OF MARRIAGES,NUMBER OF CHILDREN,NUMBER OF NOTES
  586. 10020  DATA  3
  587. 10030  DATA  DATE OF BIRTH,DATE OF DEATH OR 'NOW',"FIRST VALID MARRIAGE DATE"
  588. 10040  DATA  4
  589. 10050  DATA  MOTHER,FATHER,SPOUSES,"CHILDREN"
  590. 10060  DATA 5
  591. 10070  DATA PERFORM A SEARCH,OUTPUT SEARCH RESULT,CHANGE PROGRAM PARAMETERS,CHECK DISKETTES,EXIT PROGRAM
  592. 10075  DATA 3
  593. 10077  DATA OUTPUT TO SCREEN,OUTPUT TO PRINTER,OUTPUT TO DISKETTE
  594. 10080  DATA  3
  595. 10090  DATA SEARCH FOR DATE BETWEEN TWO YEARS,SEARCH FOR YEAR BETWEEN TWO DATES,SEARCH FOR APPEARANCES OF MONTH/DAY
  596. 10092  DATA 3
  597. 10093  DATA NUMBER OF MARRIAGES,NUMBER OF CHILDREN,NUMBER OF NOTES
  598. 10095  DATA 4
  599. 10096  DATA NUMBER RANGE,NUMBER LIST,NAME SET,LIST IN MEMORY
  600. 10097  DATA 5
  601. 10098  DATA SEARCH CHARACTER STRINGS,SEARCH DATES,SEARCH FOR NAMES,SEARCH FOR NUMBERS,"SEARCH FOR EMPTY FIELDS"
  602. 10100  DATA 7
  603. 10101  DATA TOP-OF-FORM AFTER PRINTS
  604. 10102  DATA SIZE OF LEFT MARGIN
  605. 10103  DATA USE LAST NAME FIRST
  606. 10104  DATA SHOW MARRIED NAME
  607. 10105  DATA TAB BEFORE HEADER
  608. 10106  DATA ASK FOR HEADER
  609. 10107  DATA IGNORE UPPER/LOWER CASE
  610. 11000  ONERR  GOTO 11100
  611. 11010  PRINT  CHR$(4)"OPEN CONFIGURATION": PRINT  CHR$(4)"READ CONFIGURATION": FOR I = 1 TO 64: INPUT A: NEXT 
  612. 11030  FOR I = 1 TO 40: INPUT A$: NEXT 
  613. 11040  FOR I = 1 TO 17: INPUT A: NEXT : INPUT OP(1): INPUT OP(2): FOR I = 1 TO 4: INPUT OP(3): NEXT : INPUT A: INPUT A: INPUT A: FOR I = 4 TO 6: INPUT OP(I): NEXT 
  614. 11045  FOR I = 1 TO 19: INPUT A: NEXT : FOR I = 7 TO 9: INPUT OP(I): NEXT 
  615. 11050  PRINT  CHR$(4)"CLOSE": POKE 216,0: RETURN 
  616. 11100 A =  PEEK(222): IF A = 5  OR A = 6  OR A = 8  THEN  PRINT "NO CONFIGURATION FILE AVAILABLE ON": PRINT "DISKETTE LAST USED. PLEASE SEE MANUAL.": END 
  617. 11110  PRINT "ERROR # "A". PLEASE SEE DOS MANUAL.": END 
  618. 12000  GOSUB 11000: GOSUB 850: PRINT  CHR$(4)"PR#"Q(43): IF Q(9) >0  THEN  CALL G(0)
  619. 12030  READ A: FOR I = 1 TO A: READ S$(I,0): NEXT :S$(0,0) =  STR$(A)
  620. 12040  READ A: FOR I = 1 TO A: READ S$(I,1): NEXT :S$(0,1) =  STR$(A)
  621. 12050  READ A: FOR I = 1 TO A: READ VR$(I): NEXT :VR$(0) =  STR$(A)
  622. 12060  READ CH: FOR I = 1 TO CH: READ H$(I): NEXT : GOSUB 7960
  623. 12065  READ A: FOR I = 1 TO A: READ S$(I,3): NEXT :S$(0,3) =  STR$(A)
  624. 12070  READ A: FOR I = 1 TO A: READ CH$(I): NEXT :CH$(0) =  STR$(A)
  625. 12080  READ A: FOR I = 1 TO A: READ WR$(I): NEXT :WR$(0) =  STR$(A)
  626. 12085  READ H1: FOR I = 1 TO H1: READ H1$(I): NEXT 
  627. 12087  READ A: FOR I = 1 TO A: READ S$(I,2): NEXT :S$(0,2) =  STR$(A)
  628. 12088 B$ = "":A$ = "IS": IF Q(8) >1  THEN B$ = "S":A$ = "ARE"
  629. 12090  GOSUB 850
  630. 12110 R = 0: READ OP: FOR I = 1 TO OP: READ OP$(I): NEXT :OP(3) = LO: IF   NOT Q(1)  THEN OP(1) = 0
  631. 12115 FL = 4: GOTO 18000
  632. 12120 FC = Q(22):JR = 0:X1 = 0: POKE 34,0: GOSUB 850: HTAB (Q(22) -22)/2: INVERSE : PRINT "SEARCH-RECORDS PROGRAM": NORMAL 
  633. 12130  PRINT : PRINT "SELECT A FUNCTION:": PRINT : IF LO = 0  THEN FL = 4
  634. 12140  FOR I = 1 TO CH: PRINT I") "H$(I): NEXT 
  635. 12150  PRINT : INVERSE : PRINT "WHICH (1-"CH")";: GOSUB 690: IF YN$ =  CHR$(13)  THEN 6760
  636. 12155 C1 =  VAL(YN$): IF C1 <1  OR C1 >CH  THEN 12150
  637. 12160  IF C1 = CH  THEN 6760
  638. 12170  IF C1 = CH -1  THEN 18000
  639. 12180  ON C1 GOSUB 7500,7500,9000
  640. 12190  GOTO 12120
  641. 18000  FOR I = 1 TO Q(8)
  642. 18035  ONERR  GOTO 18200
  643. 18040  PRINT  CHR$(4)"OPEN CONTROLS,S"WH(I,2)",D"WH(I,3): PRINT  CHR$(4)"READ CONTROLS": FOR J = 1 TO 7: INPUT G(J): NEXT : PRINT  CHR$(4)"CLOSE"
  644. 18050  IF G(3) = Q(14)  AND G(4) = Q(15)  AND G(5) = Q(16)  AND G(6) = Q(36)  AND G(7) = Q(38)  THEN 18100
  645. 18060  PRINT : PRINT "DISKETTE IN SLOT "WH(I,2)", DRIVE "A",": PRINT "DOES NOT MATCH THE CONFIGURATION FILE.": PRINT "PLEASE REFER TO MANUAL.": END 
  646. 18100 WH(I,0) = G(1):WH(I,1) = 0: NEXT : FOR I = 0 TO Q(37) -1:CT(I) = 0: NEXT : POKE 216,0: GOTO 18215
  647. 18200  POKE 216,0: CALL G(8):WH(I,0) =  -1
  648. 18205  PRINT "THE DISKETTE IN DRIVE "I" IS ASSUMED": PRINT "TO BE A SCRATCH ONE.": FOR BB = 1 TO 2000: NEXT 
  649. 18210  NEXT I
  650. 18215 J = 0: FOR I = 1 TO Q(8): IF WH(I,0) <0  THEN J = J +1
  651. 18220  NEXT : IF J = Q(8)  THEN  PRINT "NO DATA DISKETTES LOADED.": FOR BB = 1 TO 5000: NEXT 
  652. 20000  GOTO 12120